(FILECREATED "24-JUL-73 23:12:45" PUP)
(LISPXPRINT (QUOTE PUPVARS)
T)
[RPAQQ PUPVARS
(NEED REQUIRE $PGM $UNUSEDVARS
(FNS PURE RAMIFICATIONS OUTTUPLE EXECUTE LISPTRANSLATE
REV2ELS CELLEQUAL LISTEQUAL PULLOUT NUMERORDER
EXTREMORD ORDERING EXTREMEORDERING NEWCDR NEWCAR
NEWCARCDR ASKABOUTALL INVOLVES FLATTEN INSIDEC
SUBLISTC APPENDC REPLACECDR REPLACECAR MAKENULL
RPLAC NEWCELL ALLBUT STORECVALUE CONSC SETQC
TRANSITIVECLOSURE TRYANYTHINGANTISYMPARTIAL
SIMPLEGOAL SOLVE SETUP INIT GETNEWLOCNAME DENYALL
SERIESGOAL ORGOAL ANDGOAL XORGOAL BUILDPGM
GOBYEXAMPLE GETEXAMPLE SAMEASFN DOUBLEFN SYNTH1
SYNTH2 ASKABOUT RHMATCH RECHEAD EXTREMEPOSITION
EXTREMERELATIVEPOSITION POSITIONALJOIN POSITIONAL
RECURLIST)
(P (QSETUP PUPVARS))
(P (SETUP)
(INIT)
(PRINT (QUOTE (READY TO BEGIN PUP]
(RPAQQ NEED T)
(RPAQQ REQUIRE T)
(RPAQQ $PGM (TUPLE))
(RPAQQ $UNUSEDVARS
(CLASS U14 U16 U11 U15 U13 U17 U1 U5 U6 U2 U3 U4 U8 U10 U7 U12
U9))
(DEFINEQ
(PURE
[QLAMBDA (TUPLE (TUPLE ←A
←←B)←←C)
[QIF (QEQUAL $A COMMENT)
ELSE (PRINT (OUTTUPLE (CDR (TUPLE $A $$B]
(QIF (QEQUAL $C (TUPLE))
ELSE (PURE (TUPLE $$C])
(RAMIFICATIONS
[QLAMBDA
(TUPLE ←A
←B)
(QPROG (←L
←NEXT
←S1
←S2
←S3)
(QMATCHQ ←L
(QINSTANCES ←←ANY))
B1
(QATTEMPT (QMATCHQ (CLASS ←NEXT
←←L)
$L)
ELSE (QRETURN TRUE))
B2
[QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2
$B ←←S3)
$NEXT)
THEN (QPROG NIL (QDELETE (TUPLE $$S1 $A $$S2 $B $$S3))
(QASSERT (TUPLE $$S1 $B $$S2 $A $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2
$A ←←S3)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B $$S2 $A $$S3))
(QASSERT (TUPLE $$S1 $A $$S2 $B $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $A $$S2))
(QASSERT (TUPLE $$S1 $B $$S2))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B
$$S2))
(QASSERT (TUPLE $$S1 $A
$$S2]
B3
(QATTEMPT (QMATCHQ (TUPLE ←←S1
(TUPLE ←←NEXT)←←S2)
$NEXT)
THEN (GOTO B2)
ELSE (GOTO B1])
(OUTTUPLE
[LAMBDA (S)
(COND
((ATOM S)
S)
((EQUAL (CAR S)
(QUOTE TUPLE))
(OUTTUPLE (CDR S)))
(T (CONS (OUTTUPLE (CAR S))
(OUTTUPLE (CDR S])
(EXECUTE
[LAMBDA (I)
[EVAL (LIST (QUOTE DEFINEQ)
(LIST $NAME (APPEND (LIST (QUOTE LAMBDA)
(LIST $L)
(LIST (QUOTE SETQ)
(QUOTE EX)
$L))
I]
(($NAME (EVAL EX])
(LISPTRANSLATE
[QLAMBDA ←E
(EVAL (CDR (SASSOC $E
(QUOTE (((TUPLE FIRST ELEMENT)
TUPLE CAR $L)
((TUPLE LAST ELEMENT)
TUPLE LAST $L)
((TUPLE SECOND ELEMENT)
TUPLE CADR $L)
((TUPLE ALL BUT THE FIRST ELEMENT)
TUPLE CDR $L)
((TUPLE ALL BUT THE FIRST TWO
ELEMENTS)
TUPLE CDDR $L)
((TUPLE ALL BUT THE SECOND
ELEMENT)
TUPLE CONS (TUPLE CAR $L)
(TUPLE CDDR $L))
((TUPLE ALL BUT THE SINGLETON
LIST OF THE FIRST ELEMENT)
TUPLE CDR $L)
((TUPLE ALL BUT THE CLOSEST
ELEMENT
TO A)
TUPLE PULLOUT
(TUPLE EXTREMORD1 $L $RELNN)
$L)
((TUPLE ALL BUT THE SMALLEST
ELEMENT)
TUPLE PULLOUT
(TUPLE EXTREMORD1 $L $RELNN)
$L)
((TUPLE SMALLEST ELEMENT)
TUPLE EXTREMORD1 $L $RELNN)
((TUPLE CLOSEST ELEMENT
TO A)
TUPLE EXTREMORD1 $L $RELNN)
((TUPLE SINGLETON LIST OF THE
LAST ELEMENT)
TUPLE LIST (TUPLE LAST $L))
((TUPLE SINGLETON LIST OF THE
FIRST ELEMENT)
TUPLE LIST (TUPLE CAR $L))
($E. (PRINT (TUPLE COMMENT SORRY
I CANNOT
TRANSLATE $E])
(REV2ELS
(QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QAND (QEQUAL (QGET $RELN PARTIAL)
TRUE)
(QEQUAL (QGET $RELN ANTISYM)
TRUE))
ELSE (QFAIL))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $B $A)))
(QEXISTS (TUPLE C $A ←ACON))
(QEXISTS (TUPLE C $B ←BCON))
(QGOAL (TUPLE SERIES (TUPLE C $A $BCON)
(TUPLE C $B $ACON))
APPLY $GOALTYPE)))
(CELLEQUAL
(QLAMBDA (CLASS ←A
←B)
(QAND (QATTEMPT (QEXISTS (TUPLE C $A ←VAL1)))
(QATTEMPT (QEXISTS (TUPLE C $B ←VAL2)))
(QMATCHQ $VAL1 $VAL2))))
(LISTEQUAL
[QLAMBDA (CLASS ←A
←B)
(QPROG (←E1
←E2
←E3
←E4)
(QATTEMPT (QMATCHQ (TUPLE ←E1
←←E2)
$A)
THEN (QMATCHQ (TUPLE ←E3
←←E4)
$B)
ELSE (QATTEMPT (QMATCHQ (TUPLE ←E3
←←E4)
$B)
THEN (QRETURN FALSE)
ELSE (QRETURN TRUE)))
(QIF (QAND (CELLEQUAL (CLASS $E1 $E3))
(LISTEQUAL (CLASS $E2 $E4)))
THEN (QRETURN TRUE)
ELSE (QRETURN FALSE])
(PULLOUT
[LAMBDA (E L)
(COND
((EQUAL E (CAR L))
(CDR L))
(T (CONS (CAR L)
(PULLOUT E (CDR L])
(NUMERORDER
[LAMBDA (A B)
(ALPHORDER A B])
(EXTREMORD
(QLAMBDA (TUPLE ←L
←RELNN)
(QATTEMPT (QMATCHQ (TUPLE ←X
←Y
←←Z)
$L)
THEN (IF ($RELNN $X $Y)
THEN (EXTREMORD (TUPLE (TUPLE $X $$Z)
$RELNN))
ELSE (EXTREMORD (TUPLE (TUPLE $Y $$Z)
$RELNN)))
ELSE (CDR $L))))
(ORDERING
(QLAMBDA ←L
(QMATCHQ ←S
(TUPLE IDENTITY))
(QMATCHQ ←E1
(TUPLE FIRST ELEMENT))
(QMATCHQ ←E2
(EXTREMEORDERING $RELNN))
(PRINT (OUTTUPLE (TUPLE
IN PARTICULAR THE $$E1 OF THE NEW LIST
$L IS THE $$E2 OF THE
OLD LIST $L)))
(QMATCHQ ←RECBODY
(POSITIONALJOIN (TUPLE $E2 (ALLBUT $E2)
$E1)))
(PRINT (QUOTE (THIS ENABLED US TO GET THE RECURSIVE BODY)))
(PRINT $RECBODY)
(PRINT (QUOTE (WE NOW DETERMINE THE TERMINATION STEPS)))
(QMATCHQ ←NEWFUNC
(RECHEAD $RECBODY))
[EVAL (PRINT (OUTTUPLE (CDR $NEWFUNC]
(QMATCHQ ←PGM
(TUPLE $NEWFUNC $$PGM))))
(EXTREMEORDERING
(QLAMBDA ←RELN
(QGET (TUPLE RELN $RELN)
EXTREME)))
(NEWCDR
[LAMBDA (L)
(COND
(L (CDR L))
(T (RETFROM (QUOTE EXECUTE)
(QUOTE ((BREAKING OUT OF NEWCDR])
(NEWCAR
[LAMBDA (L)
(COND
(L (CAR L))
(T (RETFROM (QUOTE EXECUTE)
(QUOTE (BREAKING OUT OF NEWCAR])
(NEWCARCDR
[LAMBDA (L)
(COND
((NULL L)
NIL)
[(EQUAL (CAR L)
(QUOTE CDDR))
(CONS (QUOTE NEWCDR)
(LIST (CONS (QUOTE NEWCDR)
(NEWCARCDR (CDR L]
(T (CONS [COND
[(ATOM (CAR L))
(COND
((EQUAL (CAR L)
(QUOTE CAR))
(QUOTE NEWCAR))
((EQUAL (CAR L)
(QUOTE CDR))
(QUOTE NEWCDR))
(T (CAR L]
(T (NEWCARCDR (CAR L]
(NEWCARCDR (CDR L])
(ASKABOUTALL
(QLAMBDA (CLASS ←A
←←ALLTHEREST)
(ASKABOUT $A)
(QATTEMPT (QMATCHQ (CLASS)
$ALLTHEREST)
THEN [QMATCHQ ←AALH
(TUPLE (TUPLE COND $$TERM (TUPLE T $BODY]
ELSE (ASKABOUTALL $ALLTHEREST))))
(INVOLVES
(QLAMBDA (TUPLE ←T1
←T2)
(SUBLISTC (FLATTEN $T1)
(FLATTEN $T2))))
(FLATTEN
[LAMBDA (L)
(COND
((ATOM L)
(LIST L))
(T (APPEND (FLATTEN (CAR L))
(FLATTEN (CDR L])
(INSIDEC
[LAMBDA (E L)
(COND
((NULL L)
NIL)
((EQUAL E (CAR L))
T)
((AND (LISTP (CAR L))
(INSIDEC E (CAR L)))
T)
(T (INSIDEC E (CDR L])
(SUBLISTC
[LAMBDA (L1 L2)
(COND
((NULL L1)
T)
((NULL L2)
NIL)
((INSIDEC (CAR L1)
L2)
(SUBLISTC (CDR L1)
L2])
(APPENDC
(QLAMBDA (TUPLE ←FRONTLIST
←OLDLIST)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE JUST TOOK LIST $FRONTLIST
AND APPENDED IT ONTO FRONT OF LIST
$OLDLIST)
(TUPLE SETQ $OLDLIST (TUPLE APPEND
$FRONTLIST
$OLDLIST))
$$PGM))))
(REPLACECDR
(QLAMBDA (TUPLE LIST ←L
←NEWCDR
←OLDCDR
←CAR)
(QDELETE (TUPLE LIST $L (TUPLE $CAR $$OLDCDR)))
(QASSERT (TUPLE LIST $L (TUPLE $CAR $$NEWCDR)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CDR OF LIST $L
WHICH WAS $OLDCDR BY $NEWCDR)
(TUPLE RPLACD $NEWCDR $L)
$$PGM))))
(REPLACECAR
(QLAMBDA (TUPLE LIST ←L
←NEWCAR
←OLDCAR
←CDR)
(QMATCHQ ←NEWLIST
(TUPLE $NEWCAR $$CDR))
(QMATCHQ ←OLDLIST
(TUPLE $OLDCAR $$CDR))
(QDELETE (TUPLE LIST $L $OLDLIST))
(QASSERT (TUPLE LIST $L $NEWLIST))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CAR OF LIST $L
WHICH WAS $OLDCAR
BY THE CELL $NEWCAR)
(TUPLE RPLACA $NEWCAR $L)
$$PGM))))
(MAKENULL
(QLAMBDA (TUPLE LIST ←L
(TUPLE))
(QATTEMPT (QEXISTS (TUPLE LIST $L ←ANY))
THEN (QDELETE (TUPLE LIST $L $ANY)))
(QASSERT (TUPLE LIST $L (TUPLE)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE SET LIST $L TO NULL)
(TUPLE SETQ $L NIL)
$$PGM))))
(RPLAC
[QLAMBDA (TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QEXISTS (TUPLE LIST $L (TUPLE ←←CURRENT)))
(QMATCHQ (TUPLE ←CURCAR
←←CURCDR)
$CURRENT)
(QIF (LISTEQUAL (CLASS $CURCDR $CDR))
THEN (REPLACECAR (TUPLE LIST $L $CAR $CURCAR $CDR))
ELSE (QIF (CELLEQUAL (CLASS $CURCAR $CAR))
THEN (REPLACECDR (TUPLE LIST $L $CDR $CURCDR $CAR)
)
ELSE (QFAIL])
(NEWCELL
[QLAMBDA (TUPLE ←VAL
←LOC)
(QPROG (←AUXLOC)
(QMATCHQ (CLASS ←AUXLOC
←←UNUSEDVARS)
$UNUSEDVARS)
(QASSERT (TUPLE C $AUXLOC $VAL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I MAY NEED $VAL LATER
SO BEFORE I STORE SOMETHING
IN LOCATION $LOC I AM TRANSFERRING
$VAL
TO THE NEWLY CREATED LOCATION
$AUXLOC)
(TUPLE SETQ $AUXLOC $LOC)
$$PGM])
(ALLBUT
[QLAMBDA ←E
(QATTEMPT (QMATCHQ $S (TUPLE IDENTITY))
THEN (TUPLE ALL BUT THE $$E)
ELSE (QATTEMPT (QMATCHQ $S DOUBLEFN)
THEN (AND (QMATCHQ (TUPLE ←←ANY
ELEMENT)
$E)
(TUPLE ALL BUT THE $$ANY TWO ELEMENTS))
ELSE (AND (PRINT (QUOTE (SORRY BUT I CANNOT HANDLE
SCHEMA $S YET)))
(QFAIL])
(STORECVALUE
[QLAMBDA ←LOC
(QPROG (←VALU
←RESERVE)
(QATTEMPT (QEXISTS (TUPLE C $LOC ←VALU))
THEN (QATTEMPT (QBEXISTS
(TUPLE C ←RESERVE
$VALU)
THEN
(QIF (QEQUAL $RESERVE $LOC)
THEN (QFAIL)
ELSE (QPUT (TUPLE C
$RESERVE
$VALU)
NEEDED TRUE)))
ELSE (NEWCELL (TUPLE $VALU $LOC)))
ELSE (QRETURN TRUE])
(CONSC
[QLAMBDA
(TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QPROG
(←M
←S1
←S2)
(QATTEMPT (QGOAL (TUPLE LIST $L $CDR)
APPLY $GOALTYPE)
THEN (QATTEMPT
(QEXISTS (TUPLE LIST ←M
(TUPLE ←←S1
$CAR ←←S2)))
THEN [QPROG (←M2
←T)
(QMATCHQ ←T
(GETNEWLOCNAME))
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←M2
(TUPLE $T $$CDR))
(QASSERT (TUPLE LIST $L $M2))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE JUST
TOOK THE NEW CELL
$T
AND CONSED IT
ONTO $L
SINCE $CAR
ALREADY
BELONGS
TO ANOTHER LIST
STRUCTURE NAMELY
$M)
(TUPLE SETQ $T $CAR)
(TUPLE SETQ L
(TUPLE CONS $T $L)
)
$$PGM))
(QATTEMPT (QEXISTS (TUPLE C $CAR ←M2))
THEN (QASSERT (TUPLE C $T $M2]
ELSE (QPROG (←TEMP)
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←TEMP
(TUPLE $CAR $$CDR))
(QASSERT (TUPLE LIST $L $TEMP))
(QATTEMPT
(QEXISTS (TUPLE LIST $CAR ←←ANYTHING))
THEN (APPENDC (TUPLE $CAR $L))
ELSE (QMATCHQ
←PGM
(TUPLE (TUPLE COMMENT WE JUST
TOOK $CAR
AND CONSED IT
ONTO LIST $L)
(TUPLE SETQ $L
(TUPLE CONS $CAR $L)
)
$$PGM])
(SETQC
[QLAMBDA (TUPLE C ←NEWLOC
←NEWVAL)
(QPROG (←OLDLOC
←LOC2
←V)
[QATTEMPT (QEXISTS (TUPLE C ←OLDLOC
$NEWVAL))
ELSE (QPROG NIL
(QMATCHQ (TUPLE ←←A
(TUPLE COMMENT ←VOLD
NO LONGER HAS
THE VALUE
$NEWVAL)
(TUPLE ←←B)
(TUPLE ←←C)←←D)
$PGM)
(QMATCHQ (CLASS ←OLDLOC
←←UNUSEDVARS)
$UNUSEDVARS)
(QASSERT (TUPLE C $OLDLOC $NEWVAL))
(QMATCHQ ←PGM
(TUPLE $$A
(TUPLE COMMENT $VOLD NO
LONGER HAS THE
VALUE $NEWVAL
BUT SINCE WE
WILL BE NEEDING
IT LATER WE
STORED $NEWVAL
IN THE NEW
AUXILLIARY CELL
$OLDLOC)
(TUPLE $$B)
(TUPLE $$C)
(TUPLE SETQ $OLDLOC
$VOLD)
$$D]
(QATTEMPT (QEXISTS (TUPLE C ←LOC2
$NEWVAL)
NEEDED TRUE)
ELSE (QPUT (TUPLE C $OLDLOC $NEWVAL)
NEEDED TRUE))
(BUILDPGM (TUPLE $NEWLOC $NEWVAL $OLDLOC))
(QDELETE (TUPLE C $NEWLOC ←V))
(QASSERT (TUPLE C $NEWLOC $NEWVAL])
(TRANSITIVECLOSURE
[QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QEQUAL (QGET (TUPLE $RELN TRANSITIVE))
TRUE)
ELSE (QFAIL))
(QBEXISTS (TUPLE $RELN $A ←ANY)
THEN (QIF (QEQUAL $ANY $B)
THEN (QASSERT (TUPLE $RELN $A $B))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $ANY $B])
(TRYANYTHINGANTISYMPARTIAL
(QLAMBDA (TUPLE ←TYPE
←←STUFF
(TUPLE ←RELN
←A
←B)←←STUFF2)
(QIF (QAND (QGET $RELN ANTISYM)
(QGET $RELN PARTIAL))
ELSE (QFAIL))
(QIF (QOR (QATTEMPT (QEXISTS (TUPLE $RELN $A $B))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $A $B)
TEMP)
TRUE))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $B $A)
TEMP)
TRUE)))
THEN (QFAIL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT IF $A $RELN $B
THEN)
(TUPLE COND (TUPLE $RELN $A $B))
$$PGM))
(QASSERT (TUPLE $RELN $A $B))
(QPUT (TUPLE $RELN $A $B)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF THE
THEN PART OF THE COND
AND THUS BEGIN THE
ELSE PART OF THE COND)
(TUPLE (TUPLE T))
$$PGM))
(QDELETE (TUPLE $RELN $A $B))
(QASSERT (TUPLE $RELN $B $A))
(QPUT (TUPLE $RELN $B $A)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF COND EXPRESSION)
$$PGM))
(QDELETE (TUPLE $RELN $B $A))
BACKTRACK))
(SIMPLEGOAL
[QLAMBDA ←ANYTHING
(QGOAL $ANYTHING APPLY $LITTLEGUYS)
(COND
(REQUIRE (QPUT $ANYTHING REQUIRED TRUE])
(SOLVE
(QLAMBDA ←PROBLEM
(QGOAL $PROBLEM APPLY $GOALTYPE)
(QMATCHQ ←PGM
(QREVERSE $PGM))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT BEGINNING OF PROGRAM)
$$PGM
(TUPLE COMMENT END OF PROGRAM)))
(PRINT (OUTTUPLE (CDR $PGM)))
(PRINT (QUOTE "
LISP CODE ONLY"))
(PRINT (QUOTE "
"))
(PURE $PGM)
(TUPLE END OF THIS REQUEST)))
(SETUP
(QLAMBDA ←ANYTHING
(DENYALL)
(UNQTRACE PURE)
(QASSERT (TUPLE RELN SUCC)
TYPE POSITIONAL EXTREME (TUPLE LAST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT LAST
ELEMENT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT
FIRST ELEMENT)))
(QASSERT (TUPLE RELN PRED)
TYPE POSITIONAL EXTREME (TUPLE FIRST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT
FIRST ELEMENT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT LAST
ELEMENT)))
(QASSERT (TUPLE RELN ENCLOSE)
TYPE ORDERING EXTREME
(TUPLE SINGLETON LIST OF THE FIRST ELEMENT)
NARGS 1 TARGS (TUPLE (TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT ATOM)))
(QASSERT (TUPLE RELN NUMERORDER)
TYPE ORDERING EXTREME (TUPLE SMALLEST ELEMENT)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
(QASSERT (TUPLE RELN ALPHORDER)
TYPE ORDERING EXTREME (TUPLE CLOSEST ELEMENT
TO A)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYELEMENT NOT))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
(QASSERT (TUPLE SCHEMA DOUBLEFN)
STANDARD T EXTREME (TUPLE SAMEASFN)
NARGS 1 TARGS
[TUPLE (TUPLE RELN NARGS 1 NRES 1
(EQUAL (CADADR TARGS)
(CADADR TRES]
NRES 1 TRES (TUPLE (TUPLE SAMEASFN NOT)))
(QASSERT (TUPLE RELN CAR)
TYPE DESTRUCTIVE EXTREME (TUPLE LEFTMOST ATOM)
NARGS 1 TARGS (TUPLE (TUPLE ANYLIST NOT NIL))
NRES 1 TRES (TUPLE (TUPLE ANYELEMENT NOT)))
(QASSERT (TUPLE RELN CDR)
TYPE DESTRUCTIVE EXTREME (TUPLE NIL)
NARGS 1 TARGS (TUPLE (TUPLE ANYLIST NOT NIL))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT ATOM)))
(QASSERT (TUPLE RELN CONS)
TYPE CONSTRUCTIVE EXTREME (TUPLE ANYLIST)
NARGS 2 TARGS (TUPLE (TUPLE ANYELEMENT NOT)
(TUPLE ANYLIST NOT ATOM))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT)))
(QASSERT (TUPLE RELN APPEND)
TYPE CONSTRUCTIVE EXTREME (TUPLE ANYLIST)
NARGS 2 TARGS (TUPLE (TUPLE ANYLIST NOT ATOM)
(TUPLE ANYLIST NOT ATOM))
NRES 1 TRES (TUPLE (TUPLE ANYLIST NOT)))
(QASSERT (TUPLE C A A3))
(QASSERT (TUPLE C B B3))
(QASSERT (TUPLE C C C3))
(QASSERT (TUPLE C D D3))
(QASSERT (TUPLE C E E3))
(QASSERT (TUPLE C F F3))
(QASSERT (TUPLE C G G3))
(QASSERT (TUPLE C I I3))
(QASSERT (TUPLE C J J3))
(QASSERT (TUPLE C K K3))
(QASSERT (TUPLE C H H3))
(QASSERT (TUPLE LIST L1 (TUPLE)))
(QASSERT (TUPLE LIST L2 (TUPLE)))
(QASSERT (TUPLE LIST L3 (TUPLE)))
(QASSERT (TUPLE LIST L4 (TUPLE A B C)))
(QASSERT (TUPLE LIST L5 (TUPLE D E)))
(QASSERT (TUPLE LESS I J))
(QASSERT (TUPLE LESS J K))
(QASSERT (TUPLE LESS H I))
(QPUT LESS ANTISYM T)
(QPUT LESS PARTIAL T)
(QPUT LESS TRANSITIVE T)
(TUPLE SETUP COMPLETED)))
(INIT
(QLAMBDA ←ANYTHING
(QMATCHQ ←GOALTYPE
(TUPLE ORGOAL ANDGOAL XORGOAL SERIESGOAL SIMPLEGOAL
TRYANYTHINGANTISYMPARTIAL))
(QMATCHQ ←LITTLEGUYS
(TUPLE SETQC RPLAC CONSC MAKENULL TRANSITIVECLOSURE
REV2ELS RECURLIST))
(QMATCHQ ←PGM
(TUPLE))
(QMATCHQ ←UNUSEDVARS
(CLASS U1 U2 U3 U4 U5 U6 U7 U8 U9 U10 U11 U12 U13
U14 U15 U16 U17))
(QMATCHQ ←UNUSEDV
$UNUSEDVARS)
$ANYTHING
(QMATCHQ ←UNUSEDFNS
(CLASS F1 F2 F3 F4 F5 F6 F7 F8 F9 F10))))
(GETNEWLOCNAME
(QLAMBDA ←ANYTHING
(QPROG (←X)
(QMATCHQ (CLASS ←X
←←UNUSEDVARS)
$UNUSEDVARS)
(QRETURN $X))))
(DENYALL
[QLAMBDA ←ANYTHING
(QATTEMPT (QDELETE (TUPLE C ←C1
←V1)))
[QATTEMPT (QDELETE (TUPLE LIST ←L1
(TUPLE ←←V1]
(QATTEMPT (QDELETE (TUPLE LESS ←C1
←V1])
(SERIESGOAL
(QLAMBDA (TUPLE SERIES ←Z1
←←Z2)
(SETQ NEED NIL)
(SETQ REQUIRE NIL)
(QGOAL $Z1 APPLY $GOALTYPE)
(QIF (QEQUAL $Z2 (TUPLE))
THEN $PGM
ELSE (QGOAL (TUPLE SERIES $$Z2)
APPLY $GOALTYPE))))
(ORGOAL
(QLAMBDA (CLASS OR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT
FROM THE ORTASK WE SHALL
DO $Z1)
$$PGM))
ELSE (QGOAL (CLASS OR $$Z2)
APPLY $GOALTYPE))))
(ANDGOAL
[QLAMBDA (CLASS AND ←←Z)
(QPROG (←Z1
←Z2
←Z3)
(QMATCHQ ←Z3
(CLASS))
(QMATCHQ (CLASS ←Z1
←←Z2)
$Z)
(GO B2)
B1
(QMATCHQ (CLASS ←Z1
←←Z2)
$Z)
(QMATCHQ ←Z3
(CLASS $$Z3 $Z1))
(QMATCHQ ←Z
(CLASS $$Z2))
B2
(SETQ NEED T)
(SETQ REQUIRE T)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QIF (QEQUAL $Z2 (CLASS))
THEN (QIF (QEQUAL $Z3 (CLASS))
THEN $PGM
ELSE (QGOAL (CLASS AND $$Z3)
APPLY $GOALTYPE))
ELSE (QGOAL (CLASS AND $$Z2)
APPLY $GOALTYPE))
ELSE (GO B1])
(XORGOAL
(QLAMBDA (CLASS XOR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QATTEMPT (QGOAL (CLASS NONEOF $$Z2)
APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT OF THE
EXCLUSIVE
OR GOAL WE DID
$Z1
AND NO OTHERS ARE
SATISFIED)
$$PGM)))
ELSE (QGOAL (CLASS XOR $$Z2)
APPLY $GOALTYPE))))
(BUILDPGM
[QLAMBDA (TUPLE ←NEWLOC
←NEWVAL
←OLDLOC)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I JUST TRANSFERRED THE VALUE
$NEWVAL
FROM CELL $OLDLOC
TO CELL $NEWLOC)
(TUPLE SETQ $NEWLOC $OLDLOC)
$$PGM))
(QATTEMPT (QEXISTS (TUPLE C $NEWLOC ←OV))
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT $NEWLOC NO LONGER
HAS THE VALUE $OV)
$$PGM])
(GOBYEXAMPLE
(QLAMBDA ←BODY
(SETQ EX (GETEXAMPLE))
[SETQ BOD (NEWCARCDR (OUTTUPLE (CDR $BODY]
(ERRORSET (EXECUTE BOD))
(SETQ XX (CONS (QUOTE TUPLE)
EX))
(QMATCHQ ←XX
(EVAL XX))
(ASKABOUTALL (CLASS $X))))
(GETEXAMPLE
[LAMBDA NIL
(QUOTE (A B C])
(SAMEASFN
[LAMBDA (A)
A])
(DOUBLEFN
(QLAMBDA (TUPLE ←OLDARG
←REL)
(TUPLE $REL (TUPLE $REL $$OLDARG))))
(SYNTH1
(QLAMBDA ←A
(SELECTQ (CADR $A)
(NIL (TUPLE NULL $L))
(ATOM (TUPLE ATOM $L))
(FIRST (TUPLE NULL (TUPLE CDR $L)))
(LAST (TUPLE NULL (TUPLE CDR $L)))
(TUPLE EQUAL $L $$A))))
(SYNTH2
(QLAMBDA (TUPLE ←A
←B)
(COND
((NULL (CADR $B))
$B)
((EQUAL (CADR $B)
T)
$B)
((NUMBERP (CADR $B))
$B)
((EQUAL $A $B)
(TUPLE $L))
((EQUAL (LIST $A)
$B)
(TUPLE LIST $L))
((EQUAL (CADR $B)
(QUOTE FIRST))
(TUPLE (TUPLE CAR $L)))
(T (PRINT (QUOTE (I AM UNSURE ABOUT THE SYNTHESIS OF $B)))
$B))))
(ASKABOUT
[QLAMBDA
←A
(SELECTQ
(LENGTH (CDR $A))
(0 (PRINT (QUOTE (APPARENTLY NO FURTHER BASE STEP IS NEEDED
FOR SYNTACTIC REASONS)))
(IF (AND (QIN $NAME $BODY)
(NULL ONESTEP))
THEN (QAND (PRINT (QUOTE (BUT $NAME APPEARS
IN THE BODY OF THE DESIRED
FUNCTION $NAME)))
(PRINT (QUOTE (THUS I GIVE UP)))
(QFAIL)))
[IF (NULL ONESTEP)
THEN (PRINT (QUOTE (IT APPEARS THAT THE DEFINITION IS NOT
TRULY RECURSIVE
AND THUS I SHALL PROCEED]
$BODY)
(AND [PRINT (APPEND (QUOTE (IF THE INPUT IS))
(CDR $A)
(QUOTE (THEN WHAT IS THE OUTPUT??]
(SETQ ONESTEP T)
(QMATCHQ ←TERM
(TUPLE [QCONS (SYNTH1 $A)
(SYNTH2
(TUPLE $A (TUPLE (CONS (RATOM)
(READLINE]
$$TERM])
(RHMATCH
(QLAMBDA (TUPLE ←←A
(TUPLE ←←B
NOT ←←C)←←D)
(TUPLE $A $B $C $D)
BACKTRACK))
(RECHEAD
[QLAMBDA ←BODY
(QPROG (←A
←B
←C
←D
←F)
(QMATCHQ (TUPLE ←IMP
←←REST)
$BODY)
(QMATCHQ ←FF
(CLASS))
(SETQ ONESTEP NIL)
(QMATCHQ ←TERM
(TUPLE))
(QMATCHQ ←B2
(QGET (TUPLE RELN $IMP)
TARGS))
LOOP
(QATTEMPT (QMATCHQ (TUPLE ←A
←B
←C
←D)
(RHMATCH $B2))
THEN (AND (COND
((EQUAL (LENGTH $A)
1)
(QMATCHQ (TUPLE ←A1
(TUPLE ←A2
←F
←←A4)←←A5)
$BODY))
((EQUAL (LENGTH $A)
2)
(QMATCHQ (TUPLE ←A1
←A6
(TUPLE ←A2
←F
←←A4)←←A5)
$BODY))
(T (PRINT (QUOTE (LENGTH OF LIST NOT
ZERO
OR ONE
AS EXPECTED)))
(PRINT (CDR (TUPLE $A $F $BODY)))
(QFAIL)))
(QMATCHQ ←FF
(CLASS $C $$FF))
(QMATCHQ ←B2
(TUPLE $$A $$D))
(GO LOOP))
ELSE (TUPLE DEFINEQ
(TUPLE $NAME
(TUPLE LAMBDA (TUPLE $L)
(QATTEMPT (ASKABOUTALL
$FF)
THEN $AALH
ELSE (GOBYEXAMPLE
$BODY])
(EXTREMEPOSITION
(QLAMBDA ←RELATION
(QGET (TUPLE RELN $RELATION)
EXTREME)))
(EXTREMERELATIVEPOSITION
[QLAMBDA (TUPLE ←REL
←NEWARG
←OLDARG)
(QATTEMPT (QMATCHQ $NEWARG $OLDARG)
THEN (EXTREMEPOSITION $REL)
ELSE (AND (QMATCHQ ←TTEMP
(INVOLVES $NEWARG $OLDARG))
(QBEXISTS (TUPLE SCHEMA ←S)
STANDARD $TTEMP
THEN (QMATCHQ (TUPLE $REL $$OLDARG)
($S (TUPLE $NEWARG $REL)))
(APPLY* (CADR (QGET (TUPLE SCHEMA $S)
EXTREME))
(EXTREMEPOSITION $REL])
(POSITIONALJOIN
[QLAMBDA (TUPLE ←E2
←ABE2
←E1)
(QMATCHQ ←E2T
(LISPTRANSLATE $E2))
(QMATCHQ ←ABE2T
(LISPTRANSLATE $ABE2))
(QATTEMPT (QMATCHQ $E1 (TUPLE FIRST ELEMENT))
THEN (TUPLE CONS $E2T (TUPLE $NAME $ABE2T))
ELSE (QATTEMPT (QMATCHQ $E1 (TUPLE LAST ELEMENT))
THEN (TUPLE APPEND (TUPLE $NAME $ABE2T)
(TUPLE LIST $E2T))
ELSE (EVAL (PRINT (QUOTE (QFAIL])
(POSITIONAL
(QLAMBDA ←L
(QMATCHQ ←S
(TUPLE IDENTITY))
(QMATCHQ ←E1
(EXTREMEPOSITION $RELNN))
(QMATCHQ ←E2
(EXTREMERELATIVEPOSITION (TUPLE $RELNO $ARGSN
$ARGSO)))
(QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT
IN PARTICULAR THE $$E1 OF THE NEW
LIST IS THE $$E2 OF THE
OLD LIST $L))
$$PGM))
(QMATCHQ ←RECBODY
(POSITIONALJOIN (TUPLE $E2 (ALLBUT $E2)
$E1)))
(PRINT (QUOTE (THIS ENABLED US TO GET THE RECURSIVE BODY)))
(PRINT $RECBODY)
(PRINT (QUOTE (WE NOW DETERMINE THE TERMINATION STEPS)))
(QMATCHQ ←NEWFUNC
(RECHEAD $RECBODY))
[EVAL (PRINT (OUTTUPLE (CDR $NEWFUNC]
(QMATCHQ ←PGM
(TUPLE $NEWFUNC $$PGM))))
(RECURLIST
[QLAMBDA
(TUPLE LIST ←L)
(QMATCHQ (CLASS ←NAME
←←UNUSEDFNS)
$UNUSEDFNS)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I AM ABOUT
TO CONSTRUCT A POSSIBLY RECURSIVE NEW FUNCTION
WHICH I CHOOSE
TO CALL $NAME AND WHICH WILL TRANSFORM LISTS)
$$PGM))
(PRINT (OUTTUPLE (TUPLE I AM ABOUT TO CONSTRUCT A POSSIBLY
RECURSIVE FUNCTION
TO TRANSFORM LISTS)))
[PRINT (APPEND (QUOTE (THE NAME I CHOOSE FOR THIS FUNCTION IS))
(CDR (TUPLE $NAME]
[PRINT (APPEND (QUOTE (THUS I NEED MORE INFORMATION ABOUT THE
OLD VERSUS THE NEW STRUCTURE OF LIST))
(CDR (TUPLE $L]
(PRIN1 (QUOTE "OLD.... "))
(/SETQ OLDLIST (CONS (RATOM)
(READLINE)))
(SETQ TEMPO (CONS (QUOTE TUPLE)
OLDLIST))
(QMATCHQ (TUPLE ←RELNO
←←ARGSO)
(EVAL TEMPO))
(PRIN1 (QUOTE "NEW.... "))
(/SETQ NEWLIST (CONS (RATOM)
(READLINE)))
(SETQ TEMPO (CONS (QUOTE TUPLE)
NEWLIST))
(QMATCHQ (TUPLE ←RELNN
←←ARGSN)
(EVAL TEMPO))
(QMATCHQ ←RELNTYPE
(QGET (TUPLE RELN $RELNN)
TYPE))
(QATTEMPT (OR (QMATCHQ $ARGSO (TUPLE))
(QMATCHQ $RELNTYPE (QGET (TUPLE RELN $RELNO)
TYPE)))
THEN (QAND (QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT WE KNOW THAT
THE INITIAL
TO FINAL TRANSFORMATION
INVOLVES SOLELY
$RELNTYPE CHANGES))
$$PGM))
($RELNTYPE $L)
(QMATCHQ ←PGM
(TUPLE (TUPLE $NAME $L)
(TUPLE COMMENT WE APPLY OUR NEW
FUNCTION $NAME
TO OUR GIVEN ARBITRARY LIST $L)
$$PGM)))
ELSE (QAND (QMATCHQ ←PGM
(TUPLE (PRINT (TUPLE COMMENT WE KNOW THAT THE
INITIAL
TO FINAL CHANGE INVOLVES A
MIXTURE OF BOTH $RELNTYPE
AND
(QGET (TUPLE RELN
$RELNO)
TYPE)
CHANGES))
$$PGM])
)
(QSETUP PUPVARS)
(SETUP)
(INIT)
(PRINT (QUOTE (READY TO BEGIN PUP)))
STOP